perm filename EDITOR.DOC[206,LSP] blob
sn#722255 filedate 1983-08-01 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00021 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002
C00004 00003
C00005 00004 SAMPLE EDITING SESSION -1-
C00006 00005 SAMPLE EDITING SESSION -2-
C00007 00006 EDITOR
C00009 00007
C00011 00008 #n:
C00012 00009 UP:
C00013 00010 RT:
C00014 00011 LF:
C00015 00012 LI: left paren in
C00016 00013 MOVE LEFT PAREN IN
C00017 00014 LO: left paren out
C00018 00015 MOVE LEFT PAREN OUT
C00019 00016 RI: right paren in
C00020 00017 MOVE RIGHT PAREN IN
C00021 00018 RO: right paren out
C00022 00019 MOVE RIGHT PAREN OUT
C00023 00020 Insert X at position N in CE
C00025 00021 Delete the element at position N in CE
C00027 ENDMK
C⊗;
LISP Structure Editor
For editing LISP programs
Some editing operations
displaying
moving around
fixing structural mistakes
inserting and deleting list elements
fixing `string' mistakes
moving parens in, out
fixing typos
substitution
searching for pattern
undoing
`hereditary' list structures
()
(A (B C (D E)) (F G))
(OR (ATOM CE) (GREATERP N (LENGTH CE)))
non - `hereditary' list structure
(A . B)
Moving around
(1 2 3 )
OR (1 2 ) (1 2 3 )
ATOM CE GREATERP N (1 2 )
LENGTH CE
SAMPLE EDITING SESSION -1-
(LOAD '(ED LSP))
;;; buggy program
(DEFUN NTHT (U N)
(COND ((GREATERP N 1) (NTHTAIL (CDR U) (SUB1 N)))
(T U) ))
;;; correct version
(DEFUN NTHT (U N)
(COND ((AND (GREATERP N 1) (NOT (NULL (CDR U))))
(NTHTAIL (CDR U) (SUB1 N)))
(T U) ))
;;; invoke the editor
(editor ntht) p
(LAMBDA (U N)
(COND ((GREATERP N 1) (NTHTAIL (CDR U) (SUB1 N)))
(T U)))
;;; move to expression beginning with NTHTAIL
ε 3 2 2 p
(NTHTAIL (CDR U) (SUB1 N))
;;; replace NTHTAIL by NTHT
ε (D 1) (I 1 NTHT) p
(NTHT (CDR U) (SUB1 N))
SAMPLE EDITING SESSION -2-
;;; up to COND level
ε up p
((GREATERP N 1) (NTHT (CDR U) (SUB1 N)))
;;; insert ((NOT..)) clause
ε (I 2 ((NOT (NULL (CDR U)))))
((GREATERP N 1) ((NOT (NULL (CDR U)))) (NTHT ...))
;;; move `(' out
ε 2 lo p
((GREATERP N 1) (NOT (NULL (CDR U))))
;;; Insert the AND
ε (I 1 AND) up p
((AND (GREATERP N 1) (NOT (NULL (CDR U))))
(NTHT (CDR U) (SUB1 N)))
;;; Replace old definition
ε ok
(LAMBDA (U N)
(COND ((AND (GREATERP N 1) (NOT (NULL (CDR U))))
(NTHT (CDR U) (SUB1 N)))
(T U)))
EDITOR
EDITOR state
TOP - toplevel expression
CE - current expression
CHAIN - from current expression back to top
(editor ntht)
TOP =
(LAMBDA (U N)
(COND ((GREATERP N 1)
(NTHTAIL (CDR U) (SUB1 N)))
(T U)))
CE = TOP
CHAIN = NIL
ε 3 2 1 p
CE = (GREATERP N 1)
CHAIN =
((1 (GREATERP N 1) (NTHTAIL (CDR U) (SUB1 N)))
(2 COND ((GREATERP ..) (NTHTAIL ..)) (T U))
(3 LAMBDA (U N) ...) )
ε rt
CE = (NTHTAIL (CDR U) (SUB1 N))
CHAIN =
((2 (GREATERP N 1) (NTHTAIL (CDR U) (SUB1 N)))
(2 COND ((GREATERP ..) (NTHTAIL ..)) (T U))
(3 LAMBDA (U N) ...)
)
(DEFUN EDITOR FEXPR (L)
(PROG (FN TOP CE CHAIN CMD EFN)
(COND ((NULL L)
(ERRMSG0)
(RETURN 'NO-EDIT)))
(SETQ FN (CAR L))
(SETQ TOP (COPY (GET FN 'EXPR)))
(COND ((NULL TOP)
(ERRMSG0)
(RETURN 'NO-EDIT)))
(SETQ CE TOP CHAIN NIL)
EDLOOP
(PRINT 'ε)
(SETQ CMD (READ))
(COND ((EQ CMD 'Q) (RETURN 'BYE) )
((EQ CMD 'OK)
(RETURN (PUTPROP FN TOP 'EXPR)) )
((NUMBERP CMD)
(EDITOR-DOWN CMD) (GO EDLOOP))
((AND (ATOM CMD)
(SETQ EFN (GET CMD 'ATOMIC-EDIT-FN)))
(EVAL EFN)
(GO EDLOOP) )
((AND (NOT (ATOM CMD))
(SETQ EFN (GET (CAR CMD) 'LIST-EDIT-FN)))
(APPLY EFN (CDR CMD))
(GO EDLOOP)) )
(SETQ EFN (ERRSET (EVAL CMD) NIL))
(COND (EFN (PRINT (CAR EFN)))
(T (ERRMSG-EVAL-ERR)))
(GO EDLOOP) )
)
#n:
n
ce: ( .. e .. )
CHAIN: (...) ((n . ce) ...)
CE: ce e
;;; CE←NTHELT(CE,N)
(DEFUN EDITOR-DOWN (N)
(COND ((OR (ATOM CE) (GREATERP N (LENGTH CE)))
(ERRMSG1))
(T (SETQ CHAIN (CONS (CONS N CE) CHAIN))
(SETQ CE (NTHELT CE N)) ) ))
UP:
n
e: ( ..ce.. )
CHAIN: ((n . e) ...) ( ...)
CE: ce e
;;;CE ← PARENT(CE)
(DEFPROP UP
(COND ((NULL CHAIN) (ERRMSG-AT-THE-TOP))
(T (SETQ CE (CDAR CHAIN))
(SETQ CHAIN (CDR CHAIN)) )
)
ATOMIC-EDIT-FN)
RT:
n n+1
e: ( ..ce e1..)
CHAIN: ((n . e) ...) ((n+1 . e) ...)
CE: ce e1
;;;MOVE RIGHT
(DEFPROP RT
(PROG (N)
(COND ((NULL CHAIN)
(RETURN (ERRMSG-AT-THE-TOP))))
(SETQ N (ADD1 (CAAR CHAIN)))
(COND ((GREATERP N (LENGTH (CDAR CHAIN)))
(RETURN (ERRMSG-RIGHT-EDGE))))
(SETQ CE (NTHELT (CDAR CHAIN) N))
(RPLACA (CAR CHAIN) N)
)
ATOMIC-EDIT-FN)
LF:
n n+1
e: ( ..e1 ce..)
CHAIN: ((n+1 . e) ...) ((n . e) ...)
CE: ce e1
;;;MOVE LEFT
(DEFPROP LF
(PROG (N)
(COND ((NULL CHAIN)
(RETURN (ERRMSG-AT-THE-TOP))))
(SETQ N (SUB1 (CAAR CHAIN)))
(COND ((LESSP N 1)
(RETURN (ERRMSG-LEFT-EDGE))))
(SETQ CE (NTHELT (CDAR CHAIN) N))
(RPLACA (CAR CHAIN) N)
)
ATOMIC-EDIT-FN)
LI: left paren in
Before
n
CE
( ... (e ... ) ..)
-------
POS: | | |→→ d-pos
-↓-----
↓
-------
CE: | | |→→ d-ce
-↓-----
↓
e
After
n n+1
CE
( .. e ( ... ) ..)
(CE:)
------- -------
POS: | | |→→ | | |→→ d-pos
-↓----- -↓-----
↓ ↓
e d-ce
;;;MOVE LEFT PAREN IN
(DEFPROP LI
(PROG (POS)
(COND ((NULL CHAIN)
(RETURN (ERRMSG-AT-THE-TOP))))
(COND ((ATOM CE)
(RETURN (ERRMSG-CE-ATOMIC))))
(SETQ POS (NTHTAIL (CDAR CHAIN) (CAAR CHAIN)))
(RPLACA POS (CAR CE))
(RPLACA CE (CDR CE))
(RPLACD CE (CDR POS))
(RPLACD POS CE)
(SETQ CE (CAR CE))
(RPLACA (CAR CHAIN) (ADD1 (CAAR CHAIN)))
)
ATOMIC-EDIT-FN)
LO: left paren out
Before
n n+1
CE
( ... e ( ... ) ..)
POS1:
------- -------
POS: | | |→→ | | |→→ d-pos
-↓----- -↓-----
↓ ↓
e ce
After
n
CE
( ... (e ... ) ..)
-------
POS: | | |→→ d-pos
-↓-----
↓
↓
-------
(POS1:) | | |→→ ce
-↓-----
↓
e
;;;MOVE LEFT PAREN OUT
(DEFPROP LO
(PROG (POS1 POS)
(COND ((NULL CHAIN)
(RETURN (ERRMSG-AT-THE-TOP))))
(COND ((AND (ATOM CE) (NOT (NULL CE)))
(RETURN (ERRMSG-CE-ATOMIC))))
(SETQ N (SUB1 (CAAR CHAIN)))
(COND ((LESSP N 1)
(RETURN (ERRMSG-LEFT-EDGE))))
(SETQ POS (NTHTAIL (CDAR CHAIN) N))
(SETQ POS1 (CDR POS))
(RPLACD POS (CDR POS1))
(RPLACD POS1 CE)
(RPLACA POS1 (CAR POS))
(RPLACA POS POS1)
(SETQ CE POS1)
(RPLACA (CAR CHAIN) N)
)
ATOMIC-EDIT-FN)
RI: right paren in
Before
n
CE
( ... ( ... e ) ..)
-------
POS: | | |→→ d-pos
-↓-----
↓
↓ LAST:
-------
CE: (...)→| | |→NIL
-↓-----
↓
e
After
n
CE
( ... ( ... ) e ..)
(LAST:)
------- -------
POS: | | |→→ | | |→→ d-pos
-↓----- -↓-----
↓ ↓
CE: (...)→NIL e
;;;MOVE RIGHT PAREN IN
(DEFPROP RI
(PROG (LAST POS)
(COND ((NULL CHAIN)
(RETURN (ERRMSG-AT-THE-TOP))))
(COND ((ATOM CE)
(RETURN (ERRMSG-CE-ATOMIC))))
(SETQ POS
(NTHTAIL (CDAR CHAIN) (CAAR CHAIN)))
(COND ((NULL (CDR CE))
(RPLACA POS NIL)
(SETQ LAST CE)
(SETQ CE NIL) )
(T (SETQ LAST (CHOP CE)) )
)
(RPLACD LAST (CDR POS))
(RPLACD POS LAST)
)
ATOMIC-EDIT-FN)
RO: right paren out
Before
n n+1
CE
( ... ( ... ) e ..)
POS1:
------- -------
POS: | | |→→ | | |→→ d-pos
-↓----- -↓-----
↓ ↓
CE:(...) e
After
n
CE
( ... ( ... e ) ..)
-------
POS: | | |→→ d-pos
-↓-----
↓
↓ (POS1:)
-------
CE: ( ... )→→| | |→→NIL
-↓-----
↓
e
;;;MOVE RIGHT PAREN OUT
(DEFPROP RO
(PROG (POS POS1)
(COND ((NULL CHAIN)
(RETURN (ERRMSG-AT-THE-TOP))))
(COND ((AND (ATOM CE) (NOT (NULL CE)))
(RETURN (ERRMSG-CE-ATOMIC))))
(SETQ POS
(NTHTAIL (CDAR CHAIN) (CAAR CHAIN)))
(SETQ POS1 (CDR POS))
(COND ((NULL POS1)
(RETURN (ERRMSG-RIGHT-EDGE))))
(RPLACD POS (CDR POS1))
(RPLACD POS1 NIL)
(COND ((NULL CE)
(RPLACA POS POS1)
(SETQ CE POS1))
(T (NCONC CE POS1)))
)
ATOMIC-EDIT-FN)
;;; Insert X at position N in CE
(I n exp) 1≤n n-1≤len(ce)
n=1:
CE: (....)
(exp ....)
n>1
n-1
CE: (.. e ..)
(.. e exp..)
(DEFPROP I
(LAMBDA (N X)
(PROG (TMP)
(COND ((OR (NOT (GREATERP N 0))
(LESSP (LENGTH CE) (SUB1 N)))
(RETURN (ERRMSG-BAD-ARG))))
(SETQ TMP (CONS X (NTHTAIL CE N)))
;;; RESET CE AND POINTERS TO IT
(COND ((EQ N 1)
(SETQ CE TMP)
(COND ((NULL CHAIN) (SETQ TOP CE))
(T
(RPLACA (NTHTAIL (CDAR CHAIN)
(CAAR CHAIN))
CE)) )
)
(T (RPLACD (NTHTAIL CE (SUB1 N)) TMP))
)
))
LIST-EDIT-FN)
;;; Delete the element at position N in CE
(D n) 1≤n≤len(ce)
n=1:
CE: (exp....)
(....)
n>1
n-1
CE: (.. e exp..)
(.. e ..)
(DEFPROP D
(LAMBDA (N)
(COND ((OR (NOT (GREATERP N 0))
(LESSP (LENGTH CE) N))
(ERRMSG-BAD-ARG))
;;; RESET CE AND POINTERS TO IT
((EQ N 1)
(SETQ CE (CDR CE))
(COND ((NULL CHAIN) (SETQ TOP CE))
(T
(RPLACA (NTHTAIL (CDAR CHAIN)
(CAAR CHAIN))
CE)) )
)
(T (RPLACD (NTHTAIL CE (SUB1 N))
(CDR (NTHTAIL CE N)))) )
)
LIST-EDIT-FN)